home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops source / Module source / TEFwindMod.txt < prev    next >
Text File  |  1999-02-21  |  9KB  |  350 lines
  1. \ 15May93 DBH  Change echovec per mrh.  Separate TEScroller and TEwind code
  2.     \ into different files.  Implement lineEnd: method in intepret:
  3. \ 14May93 DBH Dropped new: and test: methods.
  4.     \ Added enable: and disable: methods 
  5.     \ Reworked interpret: to eliminate local variables.
  6.     \ Made theTEScroller an ivar.  Lock: and unlock: buffer in interpret:
  7. \ 11May93 DBH  NewEventLoop -> quitvec.
  8.     \ Handle tabs as 4 spaces.  Make code independent of QEinit file.
  9. \ 19May93    mrh    Made theTEscroller a subview.  Added theStack.
  10. \ Sept93    mrh    revised for new controls scheme.
  11. \ Mar94        mrh adapted for TWstr (buffer for output to TW).  Added INITFONT
  12. \                to DS: in StackView.
  13. \ Oct 97    mrh updated for PowerMops.
  14.  
  15.  
  16. need    TEScroller
  17. \ need    alert
  18.  
  19.  
  20. false    value    drawStack?        \ set true when we do something that means
  21.                                 \  the stack display needs to be redrawn
  22.  
  23. TEscroller    theTEscroller
  24.  
  25.  
  26. : TESizeCheck  ( n -- )        \ The 2.4 alert was too much of a pest.  Now
  27.     32000 >                    \ we just quietly delete some text from the
  28.                             \ front.
  29.     IF
  30.         0  2000  setSelect: theTEscroller
  31.         clear: theTEscroller
  32.         32000 dup setSelect: theTEscroller
  33.     THEN  ;
  34.  
  35.  
  36. \ support for interpretation
  37.  
  38. : skip1
  39.     1 skip: QEstr ;
  40.  
  41. : special>bl            \ 12Dec98 DBH
  42.     pos: QEstr  lim: QEstr
  43.     BEGIN
  44.         len: QEstr
  45.     WHILE
  46.         1st: QEstr
  47.         CASE[ 13  ]=>        skip1        \ DO NOT replace cr's  23Jan94 DBH
  48.             [ 0 31 RANGE]=> 32 chovwr: QEstr
  49.         DEFAULT=>            drop skip1
  50.         ]CASE
  51.     REPEAT
  52.     >lim: QEstr  >pos: QEstr
  53. ;
  54.  
  55.  
  56. : EvalFromQE  { \ ret? -- }
  57.                 \ Evaluates contents of QEstr.
  58.     reset: QEstr
  59.     BEGIN
  60.         len: QEstr
  61.     WHILE
  62.         ret chsearch: QEstr  -> ret?
  63.         special>bl            \ 12Dec98 DBH  put it back in, solves tab problem
  64.         true -> drawStack?    \ Set stack display to draw on next idle
  65.         lock: QEstr
  66.         get: QEstr  evaluate
  67.         unlock: QEstr
  68.         step: QEstr
  69.         ret? negate  skip: QEstr
  70.     REPEAT
  71.     prompt? fWind? or IF  ok  THEN
  72.     prompt? IF  cr  THEN            \ prompt & cr if required
  73. ;
  74.  
  75.  
  76. \ StackView is a view which just displays the top few stack cells.
  77. \ A possible problem is that at the time of call, Mops may have a
  78. \ variable number of its own quantities on the stack, depending on the
  79. \ circumstances of the call.  We avoid this by defining the standard
  80. \ DRAW: method to do nothing, and actually do the drawing at regular
  81. \ intervals on an idle event, which generally has the same number of
  82. \ Mops' quantities on the stack (currently 2).  We do a few tricks to
  83. \ avoid unnecessary drawing so the view doesn't flicker too much.  We
  84. \ only draw if the depth has changed since the last idle, or if the
  85. \ value drawStack? has been set true, which happens when we interpret
  86. \ something (and we set it back false ready for next time).
  87.  
  88.     0    value    lastDepth
  89.     0    value    idleCnt
  90.  
  91.  
  92. : .S+
  93.     -curs
  94.     ." Stack:  "
  95.     depth 0<  IF  ." underflow"    EXIT  THEN
  96.     depth      NIF  ." empty"      EXIT  THEN
  97.     ." depth "  depth .  cr
  98.     sp@ depth 1- FOR  dup .cell cr  4+  NEXT  drop  ;
  99.  
  100.  
  101.  
  102. :class  STACKVIEW  super{ view }
  103.  
  104. :m DS:  { \ svPort -- }        \ Does the main work for DRAWSTACK:.
  105.  
  106. \ First, if it's time to draw the stack, we make sure we've flushed
  107. \ any pending output in the main view.
  108.  
  109.     flush_TWstr
  110.  
  111. \ Now let's draw that stack...
  112.  
  113.     pushPort -> svPort                    \ Port could be anything, so we have to
  114.     get: ^myWind  set: class_as> window    \  save and restore
  115.     initFont                            \ Ensure font is right
  116.     depth -> lastDepth
  117.     oldVecs
  118.     get: viewRect  swap 15 - swap  put: tempRect
  119.     draw: tempRect                    \ Draw a frame
  120.     1 1 inset: tempRect
  121.     addr: tempRect  ClipRect
  122.     clear: tempRect
  123.     10 10 gotoxy  .s+
  124. [ ppc? ] [if]
  125.     
  126. \    getbotx: tempRect 2/ negate  0  setOrigin
  127. \    10 10 gotoxy  ." FP stack:  "
  128.     f.s+
  129. \    0 0 setOrigin
  130. [then]
  131.                                             \ include FP stack if on PPC
  132.     newVecs
  133.     noClip                            \ Easier than saving and restoring!
  134.     svPort  popPort  ;m
  135.  
  136. :m DRAW:    true -> drawStack?  ;m
  137.  
  138. :m DRAWSTACK:  { x1 -- x1 } \ 30Apr94 DBH, one less stack item to manage.
  139.     clrStk? 
  140.     IF            \ We've been told to clear the stack, so we do it,
  141.                 \  draw it, then get out.
  142.         sp0 sp!
  143. [ ppc? ] [if]
  144.         depth FOR  drop  NEXT        \ on PPC, resetting the stack
  145.                                     \  pointer won't empty the stack!
  146. [then]
  147.         ds: self
  148.         false -> clrStk?
  149.         x1  EXIT
  150.     THEN
  151.     idleCnt    NIF  5 -> idleCnt  ELSE 1 --> idleCnt  THEN
  152.     depth  lastDepth <>  idleCnt 0= and        \ draw if it's time and depth is difft
  153.     drawStack?  or  false -> drawStack?        \ but if we're told, we draw anyway
  154.     NIF  x1  EXIT  THEN
  155.     ds: self
  156.     x1 ;m
  157.  
  158. :m IDLE:    drawStack: self  ;m
  159.  
  160. :m CLASSINIT:
  161.     parLeft parTop parRight parTop  setJust: self
  162.     0 0 0 100  setBounds: self  ;m
  163.     
  164. ;class
  165.  
  166.  
  167. stackView    theStack
  168.  
  169. :class    TEFview  super{ view }        \ For the TEFwind ContView
  170.  
  171. :m CLASSINIT:
  172.     classinit: super
  173.     parLeft parTop parRight parBottom  setJust: theTEscroller
  174.     0 102 0 0  setBounds: theTEscroller
  175. ;m
  176.  
  177. ;class
  178.  
  179.  
  180. TEFview        TFV            \ This will be the ContView
  181.  
  182.  
  183. \ ============= Here's the main TEFwind class ===================
  184.  
  185. :class  TEFwind  super{ window+ }
  186.  
  187.     handle    BUFFER        \ merely a place to manipulate the TEscrap handle
  188.  
  189. :m CUT:
  190.     cut: theTEscroller
  191.     fixPanRect: theTEscroller
  192.     caretIntoView: theTEscroller  ;m
  193.  
  194. :m COPY:
  195.     copy: theTEscroller  ;m
  196.  
  197. :m PASTE:
  198.     TEScrapHandle  put: buffer  size: buffer
  199.     size: theTEScroller +  TESizeCheck
  200.     paste: theTEscroller
  201.     fixPanRect: theTEscroller
  202.     caretIntoView: theTEscroller  ;m
  203.  
  204. :m CLEAR:
  205.     clear: theTEscroller
  206.     fixPanRect: theTEscroller
  207.     caretIntoView: theTEscroller  ;m
  208.  
  209. :m SelAll:
  210.     0 32767 setSelect: theTEscroller  ;m
  211.  
  212.  
  213. :m INSERT: { addr len -- }
  214.     size: theTEscroller  len +  TESizeCheck
  215.     addr len  insert: theTEscroller  ;m
  216.  
  217.  
  218. :m INTERPRET:  { \ echoCR? -- }
  219.     selEnd: theTEscroller  selStart: theTEscroller =
  220.     IF                                    \ nothing selected
  221.         getLine: theTEscroller  ( addr len )  put: QEstr
  222.         true -> echoCR?
  223.     ELSE                                \ we have a hilited selection
  224.         handle: theTEscroller  TECopy
  225.         TEScrapHandle  put: buffer
  226.         lock: buffer
  227.         ptr: buffer  size: buffer  ( addr len )  put: QEstr
  228.         unlock: buffer
  229.         false -> echoCR?
  230.     THEN
  231.     lineEnd: theTEscroller dup setselect: theTEscroller
  232.     echoCR? IF  cr  THEN
  233.     evalFromQE  flush_TWstr
  234. ;m
  235.  
  236.  
  237. :m KEY:        \ ( char -- )
  238.     doing_key?  IF  drop  EXIT  THEN        \ KEY is handling it - we
  239.                                             \  mustn't do anything here
  240.     CASE[ 3 ( enter )    ]=>    interpret: self
  241.         [ 8 ( delete )    ]=> 8 key: theTEscroller    \ delete
  242.         [ 9 ( tab )        ]=>    4 spaces
  243.  
  244.         DEFAULT=>    size: theTEscroller 1+ TESizeCheck
  245.                      key: theTEscroller
  246.     ]CASE
  247. ;m
  248.  
  249. :m ENABLE:    enable: super    newVecs  ;m    
  250. :m DISABLE:    disable: super  ;m
  251.  
  252.  
  253. :m DRAW:
  254.     ds: theStack
  255.     (draw): super
  256. ;m
  257.  
  258.  
  259. \ :m IDLE:    idle: super  ;m
  260.  
  261. :m TextHandle:    textHandle: theTEscroller  ;m
  262.  
  263.  
  264. :m DUMP:
  265.     dump: theTEscroller ;m
  266.  
  267. ;class
  268.  
  269.                 
  270. handle    tmpHndl
  271. file    WorksheetFile
  272.  
  273. 0    value    ^TW
  274.  
  275. : SAVEWORKSHEET
  276.     " Worksheet"  name: worksheetFile
  277.     'type TEXT  'type MSET  set: worksheetfile
  278.     create: worksheetFile  ?EXIT            \ If we're on a network, this
  279.                                             \ may fail, so we just get out.
  280.     textHandle: [ ^TW ]  put: tmpHndl  lock: tmpHndl
  281.     ptr: tmpHndl  size: tmpHndl  write: worksheetFile  drop
  282.     release: tmpHndl
  283.     close: worksheetFile  drop  ;
  284.  
  285.  
  286. : GETWORKSHEET    { \ adr n -- }
  287.     " Worksheet"  name: worksheetFile
  288.     open: worksheetFile
  289.     IF  .room  EXIT  THEN            \ If it doesn't exist, we'll start a
  290.                                     \ new one with a .room display, and out.
  291.     size: worksheetFile  -> n
  292.     n  new: tmpHndl  lock: tmpHndl
  293.     ptr: tmpHndl  -> adr
  294.     adr n  read: worksheetFile
  295.     dup -39 =  if  drop  0  then  OK?        \ We don't worry if the error
  296.                                             \  was endfile
  297.     bytesRead: worksheetFile  -> n
  298.     close: worksheetFile  drop
  299.     adr n insert: [ ^TW ]
  300.     release: tmpHndl  ;
  301.  
  302.  
  303. : DO_RUN_TE  { TW-addr \ ^view left top rt bot sRt sBot -- }
  304.     -curs  -echo
  305.     TW-addr -> ^TW
  306.     deep_classinit: [ ^TW ]
  307. \    fWind? IF  close: fWind  THEN        \ say goodbye to Mr. fwind
  308.  
  309.     theStack addView: TFV  theTEscroller addView: TFV
  310. \    pause pause pause                    \ Get us to the front under sys 6
  311.                                         \  or the system clobbers scroll bars
  312.     20 -> left  50 -> top
  313.     520 -> rt  360 -> bot
  314.     screenbits  -> sBot  -> sRt  2drop
  315.     rt sRt min  -> rt
  316.     bot sBot min  -> bot
  317.     left top rt bot  put: tempRect
  318.     screenbits true setGrow: [ ^TW ]
  319.     screenbits true setDrag: [ ^TW ]
  320.     true  setZoom: [ ^TW ]
  321.  
  322.     processor 1 >
  323.     IF    true  setColor: [ ^TW ]        \ would be better to test for Color QD here
  324.     THEN
  325.  
  326.     tempRect  myDoc  docWind  true false  TFV  new: [ ^TW ]
  327.     true focus: theTEScroller
  328.     newvecs
  329.     true -> emit?                \ EMIT is now safe since we have a window
  330. \    true -> relocChk?
  331.     xts{  xUndo null xCut xCopy xPaste xClear xSelAll null doPref }
  332.                                                         3  init: EditMen
  333.     getworksheet
  334.     false -> fWindActive?        \ Mustn't forget this!!
  335. \    eventLoop
  336.     QUIT
  337. ;
  338.  
  339. : BYE+        saveWorksheet  bye  ;
  340.  
  341. : xCut        cut:  [ ^TW ]  ;
  342. : xCopy        copy: [ ^TW ]  ;
  343. : xPaste    paste: [ ^TW ]  ;
  344. : xClear    clear: [ ^TW ]  ;
  345. : xUndo        nimpl  ;
  346. : xSelAll    selAll: [ ^TW ]  ;
  347.  
  348.  
  349. endload
  350.